﻿Option Strict On
Imports Microsoft.VisualBasic
Imports System.Text.RegularExpressions

Public Class webBase
    Inherits System.Web.UI.Page

    REM 创建对象变量
    Protected objUI As New UI
    Protected fnLabelXmlDocument As System.Xml.XmlDocument

    Protected iCurPage As Long = 1
    Protected IsCheckLogin As Boolean = True
    Protected IsFilterString As Boolean = True          '是否过滤字串符
    Protected WebEnableCache As Boolean = True          '是否使用页面缓存
    Protected PageStartTime As DateTime                 '页面开始时间

    REM 内部
    Private CacheTime As Integer = 0                    '缓存时间,单位：秒
    Private RequestTimes As Integer = 0                 'request执行次数
    Private fnTemplatePath As String                    '模板路径
    Private fnRawHtmlFile As String                     '页面原文件


#Region "自定义属性"

    Public Property tHtmlFile() As String
        Get
            If String.IsNullOrEmpty(fnRawHtmlFile) Then
                fnRawHtmlFile = GetRealHtmlFile(Request.RawUrl)
            End If

            Return String.Format("{0}{1}", TemplatePath, fnRawHtmlFile)
        End Get
        Set(ByVal value As String)
            fnRawHtmlFile = GetRealHtmlFile(value)
        End Set
    End Property

    REM 页面操作动作
    Protected ReadOnly Property uAction() As String
        Get
            Return IO.Path.GetFileNameWithoutExtension(tHtmlFile)
        End Get
    End Property
    REM 定义模板目录
    Public ReadOnly Property TemplatePath() As String
        Get
            If String.IsNullOrEmpty(fnTemplatePath) Then
                Dim sKey As String = Request.Url.Host
                fnTemplatePath = System.Configuration.ConfigurationManager.AppSettings.Item(String.Concat("template:", sKey))
                If String.IsNullOrEmpty(fnTemplatePath) OrElse Not IO.Directory.Exists(Server.MapPath(fnTemplatePath)) Then
                    REM 子级域名
                    fnTemplatePath = System.Configuration.ConfigurationManager.AppSettings.Item(String.Concat("template:*.", sKey.Substring(sKey.IndexOf(".") + 1)))
                    If String.IsNullOrEmpty(fnTemplatePath) OrElse Not IO.Directory.Exists(Server.MapPath(fnTemplatePath)) Then
                        REM 默认域名
                        fnTemplatePath = System.Configuration.ConfigurationManager.AppSettings.Item("template:default")
                        If String.IsNullOrEmpty(fnTemplatePath) Then
                            fnTemplatePath = "/"
                        End If
                    End If
                End If
                If Not (Right(fnTemplatePath, 1) = "/") Then
                    fnTemplatePath = String.Concat(fnTemplatePath, "/")
                End If
            End If
            Return fnTemplatePath
        End Get
    End Property



    REM 缓存文件名
    Public ReadOnly Property CacheFileFullName() As String
        Get
            Dim FileName As String = IO.Path.ChangeExtension(IO.Path.GetFileName(Request.RawUrl), oConfig.CacheFileExtName)
            Return String.Concat(Server.MapPath(oConfig.CachePath), IO.Path.GetFileNameWithoutExtension(Request.FilePath), "\", Request.Url.Host, "\", FileName)
        End Get
    End Property


    REM 返回标签路径
    Public ReadOnly Property LabelPath() As String
        Get
            Return String.Format("{0}\{1}\", IO.Path.GetDirectoryName(tHtmlFile), IO.Path.GetFileNameWithoutExtension(tHtmlFile))
        End Get

    End Property

    REM 系统管理员SESSION
    Public ReadOnly Property oConfig() As ClsConfig
        Get
            REM 测试系统配置ObjConfig的类是否存在,存在的引用Application的对象

            If Application.Contents("AppConfig") Is Nothing Then
                oConfig = New ClsConfig("default")
                reWriteConfig(oConfig)
            Else
                Return CType(Application.Contents("AppConfig"), ClsConfig)
            End If

        End Get
    End Property

    REM 系统管理员SESSION
    Public ReadOnly Property mAdmin() As ClsAdmin
        Get
            If Session.Contents("LgnAdmin") Is Nothing Then
                Dim tmpObj As New ClsAdmin
                Session.Contents("LgnAdmin") = tmpObj
                Return tmpObj
            Else
                Return CType(Session.Contents("LgnAdmin"), ClsAdmin)
            End If
        End Get
    End Property

    REM 通行证Session 
    Protected ReadOnly Property mPassport() As ClsPassport
        Get
            If Session.Contents("LgnPassport") Is Nothing Then
                Dim tmpObj As New ClsPassport
                Session.Contents("LgnPassport") = tmpObj
                Return tmpObj
            Else
                Return CType(Session.Contents("LgnPassport"), ClsPassport)
            End If
        End Get
    End Property

    REM 标签XML Document
    Public ReadOnly Property LabelXmlDocument() As System.Xml.XmlDocument
        Get
            If fnLabelXmlDocument Is Nothing Then
                Try
                    fnLabelXmlDocument = New System.Xml.XmlDocument
                    If IO.File.Exists(Server.MapPath(String.Concat(LabelPath, "label.xml"))) Then
                        fnLabelXmlDocument.Load(Server.MapPath(String.Concat(LabelPath, "label.xml")))
                    End If
                Catch ex As Exception
                    ObjectDispose()
                    Response.Write(String.Format("{0},页面配置文件加载失败.", 500))
                    Response.End()
                End Try
            End If
            Return fnLabelXmlDocument
        End Get

    End Property

#End Region

#Region "模块加载功能区"

    REM 读取指定URL和KEY的HtmlData
    Protected Function getHtmlData(ByVal fnKey As String) As String

        Dim iCT As Integer = 0
        Dim sPara As String = ""
        If Not Request.QueryString("cachetime") Is Nothing Then iCT = CType(Request.QueryString("cachetime"), Integer)
        If Not Request.QueryString("param") Is Nothing Then sPara = CType(Request.QueryString("param"), String)
        Return ReplaceRequestString(LoadList(fnKey, iCT, sPara))

    End Function


    REM 查找CITY:LIST标签并替换LIST
    Protected Sub ChkList(ByRef fnOutHtml As String)
        Dim fnMatchs As MatchCollection
        Dim sparam As String
        Dim sb As New StringBuilder(fnOutHtml)
        fnMatchs = Regex.Matches(sb.ToString, "<city:list(?:\s*|\s+cache=\""(?'2'\d+)\"")(?:\s*|\s+param=\""(?'3'[^\""\>]*)\"")\s*>(?<1>.*)<\/city:list>", RegexOptions.IgnoreCase Or RegexOptions.Compiled)
        Dim iCacheTime As Integer = 0
        For Each m As Match In fnMatchs
            iCacheTime = 0
            If String.IsNullOrEmpty(m.Groups.Item(2).Value) OrElse Not IsNumeric(m.Groups.Item(2).Value) Then
                iCacheTime = 0
            Else
                iCacheTime = CType(m.Groups.Item(2).Value, Integer)
            End If
            If m.Groups.Item(3).Value.Length = 0 Then
                sparam = ""
            Else
                sparam = m.Groups.Item(3).Value
            End If
            sb.Replace(m.Value, LoadList(m.Groups.Item(1).Value, iCacheTime, sparam))
        Next
        fnMatchs = Nothing
        fnOutHtml = sb.ToString
        sb = Nothing
    End Sub

#End Region

#Region "加载City:List列表功能"

    REM 返回特定页面的缓存时间
    Protected Function GetCacheTime(ByVal fnHtmlString As String) As Integer
        Dim CacheTime As Integer = 0
        Dim m As Match = Regex.Match(fnHtmlString, "<!--cachetime-(?'cachetime'\d+)-->", RegexOptions.IgnoreCase And RegexOptions.Compiled)
        If m.Success Then
            If String.IsNullOrEmpty(m.Groups.Item("cachetime").Value) Then
                CacheTime = 0
            Else
                CacheTime = CType(m.Groups.Item(2).Value, Integer)
            End If
            'OutHtml.Replace(m.Groups.Item(1).Value, String.Empty)
        End If
        Return CacheTime
    End Function

    REM 加载CITY:LIST列表
    Public Function LoadList(ByVal fnKey As String) As String
        Return LoadList(fnKey, 0, "")
    End Function

    REM 加载CITY:LIST列表
    Public Function LoadList(ByVal fnKey As String, ByVal fnCacheSeconds As Integer, ByVal fnParam As String) As String
        Dim fnXmlElement As System.Xml.XmlNode
        Dim fnStartTime As DateTime = DateTime.Now
        Dim fnOutHtml As String = String.Empty
        Dim strOrderby As String = String.Empty
        Dim iRightsMode As Int16
        Dim iRowCount As Long = 0
        fnXmlElement = LabelXmlDocument.SelectSingleNode("/Labels/List[Name='" & fnKey & "']")

        If fnXmlElement Is Nothing Then
            fnOutHtml = String.Format("[{0}]!!!", fnKey)
        Else
            Dim XsltUrl As String = fnXmlElement.ChildNodes(3).InnerText

            REM 测试是否存在,不存在则指向LabelPath目录
            If Not IO.File.Exists(Server.MapPath(XsltUrl)) Then XsltUrl = String.Concat(LabelPath, fnXmlElement.ChildNodes(3).InnerText)

            Dim pKey As String = fnXmlElement.ChildNodes(2).InnerText
            If Not fnXmlElement.ChildNodes(4) Is Nothing Then
                Dim RightText As String = fnXmlElement.ChildNodes(4).InnerText
                Dim Rights As String() = Split(RightText, "|")
                If Rights.Length = 2 Then
                    iRightsMode = CType(Rights(0), Int16)
                    If iRightsMode = 1 Then
                        If Not ChkAdminRights(mAdmin.AccCode, tHtmlFile, Rights(1)) Then
                            Return String.Format("{0},对不起!!帐号没有({3})权限[{1}]-{2}.", 403, fnKey, tHtmlFile, Rights(1))
                        End If
                    ElseIf iRightsMode = 0 Then
                        If Not ChkPassportRights(mPassport.ID, Rights(1)) Then
                            Return String.Format("{0},对不起!!!您未登录或没有权限使用[{1}]-{2}." + tHtmlFile + fnKey + "]!!!", 403, fnKey, tHtmlFile)
                        End If
                    ElseIf iRightsMode = 2 Then
                        If Not ChkQueryStringVaidCode() Then
                            Return String.Format("{0},请填写验证码!!!", 103)
                        End If
                    End If
                Else
                    Return String.Format("{0}, 无效的ACL[{1}]设置!!!", 403, fnKey)
                End If
            End If
            If Not IsNumeric(iCurPage) Then
                Return String.Format("{0},页码参数(Page)错误,必须是数字", 501)
            End If
            Dim aParamaters As String() = Split(ReplaceRequestString(pKey), "|")
            Dim tXslDoc As New System.Xml.XmlDocument
            Dim tXslTrans As New System.Xml.Xsl.XslCompiledTransform
            Try
                Dim CacheName As String = String.Concat(fnKey, "_", fnParam, "_", iCurPage)
                If fnCacheSeconds > 0 And Not Cache(CacheName) Is Nothing Then
                    fnOutHtml = String.Concat("<!--读取CACHE(", CacheName, ")-time(", fnCacheSeconds, ")-->", CType(Cache(CacheName), String))
                Else
                    If IO.File.Exists(Server.MapPath(XsltUrl)) Then
                        Dim iMaxRowEveryPage As Integer = 0
                        Dim tXmlDoc As System.Xml.XmlDocument

                        Dim QueryTable As String = aParamaters(0)
                        Dim strWhere As String
                        If aParamaters.Length > 4 Then
                            strWhere = aParamaters(4)
                        Else
                            strWhere = String.Empty
                        End If
                        Dim re As New Regex("{SP:([a-zA-Z_0-9._]+)}", RegexOptions.IgnoreCase)
                        If re.IsMatch(QueryTable) Then '判断是否为存储过程
                            tXmlDoc = oDB.GetSpListXml(re.Match(QueryTable).Groups.Item(1).Value(), aParamaters)
                        Else
                            If Not IsNumeric(aParamaters(1)) Then
                                Return String.Format("{0},(Page)类型错误,必须是数字", 501)
                            End If
                            tXmlDoc = oDB.GetListXml(QueryTable, CType(aParamaters(1), Integer), iCurPage, aParamaters(2).ToString, aParamaters(3).ToString, strWhere, iRowCount)
                            iMaxRowEveryPage = CType(aParamaters(1), Integer)
                            strOrderby = aParamaters(3).ToString
                        End If
                        tXslDoc.Load(Server.MapPath(XsltUrl))
                        Dim tmpStr As New StringBuilder(tXslDoc.OuterXml.ToString)

                        REM 加载XmlDocument的运行参数
                        tmpStr.Replace("{ROWCOUNT}", iRowCount.ToString)
                        tmpStr.Replace("{MAXROW}", iMaxRowEveryPage.ToString)
                        tmpStr.Replace("{CURPAGE}", iCurPage.ToString)
                        tmpStr.Replace("{PARAM}", fnParam)
                        tmpStr.Replace("{TEMPLATENAME}", fnKey)
                        tmpStr.Replace("{ORDERBY}", strOrderby)
                        tmpStr.Replace("{WHERE}", strWhere)
                        tmpStr.Replace("{RUNTIME}", ((DateTime.Now - fnStartTime).Milliseconds / 1000).ToString)

                        tmpStr = New StringBuilder(ReplaceRequestString(tmpStr.ToString))

                        tXslDoc.LoadXml(tmpStr.ToString)
                        tXslTrans.Load(tXslDoc, System.Xml.Xsl.XsltSettings.TrustedXslt, New System.Xml.XmlUrlResolver)
                        fnOutHtml = XmlTrans(tXmlDoc, tXslTrans)

                        tmpStr = Nothing
                    Else
                        fnOutHtml = String.Format("{0},不存在[{1}]", 404, XsltUrl)
                    End If
                    If fnCacheSeconds > 0 Then
                        Cache.Insert(CacheName, String.Concat(fnOutHtml, "<!--缓存时间(", Now().ToString, ")-->"), Nothing, DateTime.Now.AddSeconds(fnCacheSeconds), TimeSpan.Zero)
                    Else
                        Cache.Remove(CacheName)
                    End If
                End If
            Catch ex As Exception
                fnOutHtml = String.Format("{0},<font color='#FF0000'>(LoadList)Error:{1}.</font>", 500, ex.Message)
            End Try
        End If
        Return ReplaceRequestString(fnOutHtml)
    End Function

    REM XSL解析XML数据,并返回结果
    Public Function XmlTrans(ByVal XmlDoc As System.Xml.XmlDocument, ByVal XslDoc As System.Xml.Xsl.XslCompiledTransform) As String
        Dim RtnStr As String = ""
        Dim fnIoWriter As New System.Text.StringBuilder
        Dim fnXslArgList As New System.Xml.Xsl.XsltArgumentList
        Dim fnXmlWriterSettings As New System.Xml.XmlWriterSettings

        If Not XslDoc Is Nothing And Not IsNothing(XmlDoc) Then
            Try
                fnXmlWriterSettings.ConformanceLevel = System.Xml.ConformanceLevel.Auto
                XslDoc.Transform(XmlDoc, System.Xml.XmlWriter.Create(fnIoWriter, fnXmlWriterSettings))

            Catch ex As Exception
                fnIoWriter.Append("<font color='#FF0000'>(XmlTrans)解析出错:" & ex.Message & "</font>")
            Finally

            End Try
        Else
            fnIoWriter.Append("<font color='#FF0000'>(XmlTrans)数据库出错,原因:" & oDB.ErrMessage & "</font>")
        End If

        RtnStr = fnIoWriter.ToString

        fnIoWriter = Nothing
        fnXmlWriterSettings = Nothing

        Return RtnStr

    End Function

#End Region

    REM GetRealHtmlFile ,过滤?后,及-
    Public Function GetRealHtmlFile(ByVal fnRawFile As String) As String
        fnRawFile = Regex.Replace(fnRawFile, "/(?'1'[^/-]+)\-(?'2'[^.]*)\.", "/$1.", RegexOptions.IgnoreCase Or RegexOptions.Compiled)
        If fnRawFile.IndexOf("?") > -1 Then
            fnRawFile = fnRawFile.Substring(0, fnRawFile.IndexOf("?"))
        End If
        Return fnRawFile
    End Function

    REM 替换请求的特定字符
    Public Function ReplaceRequestString(ByRef fnOutHtml As String) As String

        RequestTimes = RequestTimes + 1
        If RequestTimes >= 99 Then
            ObjectDispose()
            Response.Write("100,对不起!!程序出现99次以上的循环,请检查程序!!")
            Response.End()
        End If

        Dim sb As New Text.StringBuilder(fnOutHtml)
        Dim options As RegexOptions = RegexOptions.Compiled Or RegexOptions.IgnoreCase

        Dim fnMatchs As MatchCollection
        REM 使用帐号ID替换{$$}
        sb.Replace("{$$}", mPassport.ID.ToString())

        sb.Replace("{$sessionid$}", Session.SessionID)

        REM 替换[XXX={request:YYY}]的表达式
        fnMatchs = Regex.Matches(sb.ToString, "\[(.*)={request:(\w+)}\]", options)
        For Each m As Match In fnMatchs
            If Request.QueryString(m.Groups.Item(2).Value) = "0" Then
                sb.Replace(m.Value, " 1=1 ")
            Else
                sb.Replace(m.Value, m.Groups.Item(1).Value & "=" & StringFilter(Request.QueryString(m.Groups.Item(2).Value)))
            End If
        Next

        Dim tmpStr As String = String.Empty
        fnMatchs = Regex.Matches(sb.ToString(), "{(?'1'request|login|admin|config|server|cookie):(?'2'\w+):?(?'3'\w*)}", options)
        For Each m As Match In fnMatchs
            REM 如果标头不存在
            If String.IsNullOrEmpty(m.Groups.Item(1).Value) Then
                Continue For
            End If

            Select Case m.Groups.Item(1).Value
                Case "request"
                    If Request.QueryString(m.Groups.Item(2).Value) Is Nothing Then
                        tmpStr = m.Groups.Item(3).Value
                    Else
                        REM 过滤'|'字符防止数据分组错误
                        tmpStr = Request.QueryString(m.Groups.Item(2).Value)
                        If Not IsNothing(tmpStr) Then tmpStr = tmpStr.Replace("|", "~~~")

                        REM 增加数据库过滤
                        tmpStr = objUI.SqlFilter(tmpStr, oConfig.SiteConfig("SqlLabel"))

                    End If

                Case "login" REM 登录信息
                    tmpStr = LoadLoginInfo(m.Groups.Item(2).Value)

                Case "config" REM 网站配置信息
                    Try
                        tmpStr = oConfig.SiteConfig(m.Groups.Item(2).Value)
                    Catch ex As Exception
                        tmpStr = "无此配置"
                    End Try

                Case "admin" REM 管理员信息
                    Try
                        tmpStr = mAdmin.getProperty(m.Groups.Item(2).Value)
                    Catch ex As Exception
                        tmpStr = "无此属性"
                    End Try

                Case "server" REM 读取ServerVariables值
                    Try
                        tmpStr = Request.ServerVariables(m.Groups.Item(2).Value)
                    Catch ex As Exception
                        tmpStr = m.Groups.Item(2).Value + "无效"
                    End Try

                Case "cookie" REM Cookie值
                    tmpStr = Request.Cookies(m.Groups.Item(2).Value).Value

                Case Else REM 空值
                    tmpStr = String.Empty
            End Select
            sb.Replace(m.Value, StringFilter(tmpStr))
        Next

        REM 当前时间
        fnMatchs = Regex.Matches(sb.ToString(), "{now:?(?'1'[^}]*)}", options)
        For Each m As Match In fnMatchs
            If Not String.IsNullOrEmpty(m.Groups.Item(1).Value) Then
                sb.Replace(m.Value, DateTime.Now.ToString(m.Groups.Item(1).Value))
            Else
                sb.Replace(m.Value, DateTime.Now.ToString())
            End If
        Next

        fnMatchs = Regex.Matches(sb.ToString, "<city_list(?:\s*|\s+cache=\""(?'2'\d+)\"")(?:\s*|\s+param=\""(?'3'[^\""\>]*)\"")\s*>(?'1'[^<]+)</city_list>", options)
        Dim iCacheTime As Integer = 0
        Dim sParam As String = ""
        For Each m As Match In fnMatchs
            iCacheTime = 0
            If String.IsNullOrEmpty(m.Groups.Item(2).Value) OrElse Not IsNumeric(m.Groups.Item(2).Value) Then
                iCacheTime = 0
            Else
                iCacheTime = CType(m.Groups.Item(2).Value, Integer)
            End If
            If m.Groups.Item(3).Value.Length = 0 Then
                sParam = ""
            Else
                sParam = m.Groups.Item(3).Value
            End If
            sb.Replace(m.Value, LoadList(m.Groups.Item(1).Value, iCacheTime, sParam))
        Next

        REM  解密
        fnMatchs = Regex.Matches(sb.ToString, "{decrypt:([^}]*)}", options)
        For Each m As Match In fnMatchs
            Try
                sb.Replace(m.Value, StringFilter(oConfig.Decrypt(m.Groups.Item(1).Value)))
            Catch ex As Exception
                sb.Replace(m.Value, m.Groups.Item(1).Value)
            End Try
        Next

        REM 加密
        fnMatchs = Regex.Matches(sb.ToString, "{encrypt:([^}]*)}", options)
        For Each m As Match In fnMatchs
            Try
                sb.Replace(m.Value, StringFilter(oConfig.Encrypt(m.Groups.Item(1).Value)))
            Catch ex As Exception
                sb.Replace(m.Value, m.Groups.Item(1).Value)
            End Try
        Next

        REM UrlCode
        fnMatchs = Regex.Matches(sb.ToString, "{urlcode:([^}]*)}", options)
        For Each m As Match In fnMatchs
            Try
                sb.Replace(m.Value, StringFilter(Server.UrlEncode(m.Groups.Item(1).Value)))
            Catch ex As Exception
                sb.Replace(m.Value, m.Groups.Item(1).Value)
            End Try
        Next
        REM 替换{fragurl:YYY}的表达式
        fnMatchs = Regex.Matches(sb.ToString, "\[fragurl(?:\s*|\s+html\-ouput=\""(?'2'\w*)\"")\s*](\w+)\[/fragurl\]", options)
        Dim fnMode As String = String.Empty
        For Each m As Match In fnMatchs
            If m.Groups.Item(2).Value.Length = 0 Then
                fnMode = "no"
            Else
                fnMode = m.Groups.Item(2).Value
            End If
            sb.Replace(m.Value, LoadArticleFrag(m.Groups.Item(1).Value, fnMode))
        Next

        fnMatchs = Nothing

        Return objUI.XmlFilter(sb.ToString) REM 过滤XML无效字符

    End Function


    REM 加载文章片断
    Public Function LoadArticleFrag(ByVal fnUrl As String) As String
        Return LoadArticleFrag(fnUrl, "text")
    End Function

    Public Function LoadArticleFrag(ByVal fnUrl As String, ByVal fnMode As String) As String

        If fnUrl.Length = 0 Then
            Return fnUrl
        Else
            fnUrl = oConfig.Decrypt(fnUrl.ToString)
        End If

        If Not System.IO.File.Exists(Server.MapPath(fnUrl)) Then
            Return fnUrl
        ElseIf Regex.IsMatch(fnUrl, "\.fra$") Then
            fnUrl = Server.MapPath(fnUrl)
        Else
            Return fnUrl
        End If

        Dim FragContent As String

        FragContent = oConfig.LoadHtmlFile(fnUrl)

        If FragContent.Length = 0 Then
            Return String.Empty

        ElseIf oConfig.IsCryptData Then

            FragContent = oConfig.Decrypt(FragContent)
        End If
        If fnMode = "yes" Then
            FragContent = objUI.HtmlOutput(FragContent)
        Else
            FragContent = objUI.HtmlFilter(FragContent)
        End If
        Return FragContent

    End Function


    REM 
    Public Sub ObjectDispose()
        reWriteConfig(oConfig)
        oDB = Nothing
        objUI = Nothing
        fnLabelXmlDocument = Nothing
    End Sub

#Region "解析特定的Xml和FileXml"

    REM 查找CITY:XML标签并替换XML
    Protected Sub ChkXML(ByRef fnOutHtml As String)
        Dim fnMatchs As MatchCollection
        Dim XsltUri As String = String.Empty
        Dim XmlString As String = String.Empty
        Dim XslDoc As New System.Xml.XmlDocument
        Dim XslTrans As New System.Xml.Xsl.XslCompiledTransform
        Dim fnXmlDocument As New System.Xml.XmlDocument
        Dim sb As New StringBuilder(fnOutHtml)

        fnMatchs = Regex.Matches(fnOutHtml, "<city_xml(?:\s*|\s+xslt=\""(?'1'[^""]*)\"")\s*(?:/>|>(?'2'[^<]*)</city_xml>)", RegexOptions.IgnoreCase Or RegexOptions.Compiled)
        For Each m As Match In fnMatchs
            XmlString = m.Groups.Item(2).Value
            XsltUri = m.Groups.Item(1).Value

            REM  检查XML是否存在
            If Not XmlString Is Nothing AndAlso IO.File.Exists(Server.MapPath(XmlString)) Then
                fnXmlDocument.Load(Server.MapPath(XmlString))
            End If
            REM  检查Xslt 是否存在
            If XsltUri Is Nothing OrElse Not IO.File.Exists(Server.MapPath(XsltUri)) Then
                sb.Replace(m.Value, fnXmlDocument.OuterXml)
            Else

                XslDoc.Load(Server.MapPath(XsltUri))
                XslDoc.LoadXml(ReplaceRequestString(XslDoc.OuterXml))
                XslTrans.Load(XslDoc, System.Xml.Xsl.XsltSettings.TrustedXslt, New System.Xml.XmlUrlResolver)
                sb.Replace(m.Value, XmlTrans(fnXmlDocument, XslTrans))
            End If
        Next

        fnMatchs = Nothing
        fnXmlDocument = Nothing
        XslDoc = Nothing
        XslTrans = Nothing
        fnOutHtml = sb.ToString
        sb = Nothing
    End Sub

#End Region


#Region "页面事件"

    Private Sub Page_Disposed(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Disposed
        ObjectDispose()
    End Sub

    Private Sub Page_Init(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Init
        Page.EnableViewState = False
    End Sub

    Private Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

        REM ----------------------PAGE 参数引用------------------------
        If Not Request.QueryString("page") Is Nothing Then
            Try
                iCurPage = CType(Request.QueryString("page"), Integer)
            Catch ex As Exception
                iCurPage = 1
            End Try

        End If


        REM --------------检查模板文件和缓存是否存在----------------
        If IO.File.Exists(Server.MapPath(tHtmlFile)) Then

            REM 检查缓存文件
            If CheckCache() Then
                Response.TransmitFile(CacheFileFullName)
                ObjectDispose()
                Response.End()
            End If

        End If

        REM --------------------加载动态页面数据-----------------------

        REM 构建数据库连接类
        oDB = New ClsDb(Request.Url.Host)

    End Sub


    Private Sub Page_Unload(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Unload
        ObjectDispose()
    End Sub


#End Region


#Region "其他功能"
    REM 加载用户登录信息
    Public Function LoadLoginInfo(ByVal fnKey As String) As String

        If Not mPassport.IsLogin And Not mAdmin.IsLogin Then
            Return String.Empty
        End If
        Dim fnHtmlStr As New StringBuilder()
        Try
            Select Case fnKey.ToUpper
                Case "USERNAME"
                    fnHtmlStr.Append(mPassport.UserName)
                Case "LASTLOGINTIME"
                    fnHtmlStr.Append(mPassport.LastLoginTime)
                Case "LOGINCOUNT"
                    fnHtmlStr.Append(mPassport.LoginCount)
                Case "MODE"
                    fnHtmlStr.Append(mPassport.F_Mode)
                Case "ADMINMENU"
                    fnHtmlStr.Append(mAdmin.GenMenu())
                Case Else
                    fnHtmlStr.Append(mPassport.GetValueByTagName(fnKey))
            End Select
        Catch ex As Exception
            fnHtmlStr.AppendLine(ex.Message)
        End Try

        Return fnHtmlStr.ToString
    End Function

    REM 替换非法字符为**
    Public Function StringFilter(ByVal fnOldString As String) As String
        If fnOldString Is Nothing Then Return String.Empty
        If IsFilterString And fnOldString.Length > 0 Then
            If oConfig.BadWord.Length > 0 Then
                Return Regex.Replace(fnOldString, oConfig.BadWord, "**", RegexOptions.Compiled)
            Else
                Return fnOldString
            End If
        Else
            Return fnOldString
        End If
    End Function

#End Region


    REM 重写配置至APPLICATION
    Public Sub reWriteConfig(ByVal tmpObj As ClsConfig)
        Application.Lock()
        Application.Contents("AppConfig") = tmpObj
        Application.UnLock()
    End Sub

    REM 检查缓存
    Public Function CheckCache() As Boolean

        CacheTime = oConfig.WebCacheTime(Server.MapPath(tHtmlFile))

        If CacheTime = 0 Then
            Return False
        Else
            Dim CreateTime As Date = IO.File.GetLastWriteTime(CacheFileFullName)
            If DateAdd(DateInterval.Second, CacheTime, CreateTime) > Now Then
                Return True
            End If
        End If
        Return False

    End Function

    REM 页面输出
    Public Sub WriteOutHtml()

        If Not IO.File.Exists(Server.MapPath(tHtmlFile)) AndAlso Not oConfig.AppSettings("City:Debug") = "1" Then
            ObjectDispose()
            Response.Status = "404 Not Found"
            Response.End()
        End If

        Response.Buffer = True

        If Request.QueryString("mustupdate") = "now" Then
            If IO.File.Exists(CacheFileFullName) Then IO.File.Delete(CacheFileFullName)
        End If

        oDB.LogVistor(mPassport.ID, Request)

        REM ---------------------------------------------------------------------------
        If IsCheckLogin Then CookieLogin()
        REM ---------------------------------------------------------------------------

        Dim OutHtml As String
        OutHtml = oConfig.LoadHtmlFile(Server.MapPath(tHtmlFile))


        REM 替换字符
        OutHtml = ReplaceRequestString(OutHtml)

        REM 替换<city:list>模块
        ChkList(OutHtml)

        ChkXML(OutHtml)

        REM 页面HTML 缓存
        If CacheTime > 0 Then oConfig.Save2Cache(String.Concat(OutHtml, "<!--cache on ", Now(), "-->"), CacheFileFullName, CacheTime)

        Response.Write(String.Concat(OutHtml, "<!--Run Time- ", ((DateTime.Now - PageStartTime).Milliseconds / 1000).ToString, "s -->"))

        reWriteConfig(oConfig)

        Response.Flush()
    End Sub

    REM 指定HtmlFile输出
    Public Sub WriteOutHtml(ByVal fnHtmlFile As String)
        tHtmlFile = fnHtmlFile
        Call WriteOutHtml()
    End Sub

#Region "登录及权限控制功能"

    REM 使用Cookie 登录系统
    Public Sub CookieLogin()
        REM 测试Cookie Login
        If Not mPassport.IsLogin Then
            Dim SessionCookie As HttpCookie = Request.Cookies(String.Concat(FormsAuthentication.FormsCookieName, "_Ticket"))

            If Not SessionCookie Is Nothing Then
                If mPassport.Login(oConfig.Decrypt(SessionCookie.Values("User_")), oConfig.Decrypt(SessionCookie.Values("Password_")), Request.ServerVariables("REMOTE_ADDR")) = 0 Then
                    Session.Contents("LgnPassport") = mPassport
                    SessionCookie.Domain = oConfig.AppSettings("City:Domain")
                    Response.SetCookie(SessionCookie)
                End If
            End If


        End If
    End Sub

    REM 请求是否来自本站
    Public Sub IsBasePath()
        Dim Post_Path As String = Request.ServerVariables("http_referer")
        If Not Post_Path Is Nothing Then
            If Left(Mid(Post_Path, 8), InStr(Mid(Post_Path, 8), "/") - 1) <> Request.ServerVariables("http_host") Then
                ObjectDispose()
                Response.Write("0,非法提交数据!!系统不受理!!  ")
                Response.End()
            End If
        End If
    End Sub

    REM 检验管理员权限
    Public Function ChkAdminRights(ByVal fnAdminCode As String, ByVal fnMenuHtmlFile As String, ByVal fnAct As String) As Boolean
        Dim sbFile As New StringBuilder()
        sbFile.Append(fnMenuHtmlFile.Substring(fnMenuHtmlFile.LastIndexOf("/") + 1))
        If sbFile.ToString.LastIndexOf("?") > 0 Then
            sbFile.Remove(sbFile.ToString.LastIndexOf("?"), sbFile.ToString.Length)
        End If
        Return oConfig.GetIsAllowUse(CInt(fnAdminCode), sbFile.ToString.Split(CChar("#"))(0), fnAct)
    End Function

    REM 检验用户权限
    Public Function ChkPassportRights(ByVal fnPassportID As Integer, ByVal AllowPassportList As String) As Boolean
        If AllowPassportList = "*" Then
            If mPassport.IsLogin Then
                Return True
            End If
        Else
            Return Array.Exists(Split(AllowPassportList, ","), AddressOf allArray)
        End If
        Return False
    End Function

    Protected Function allArray(ByVal fnString As String) As Boolean
        If fnString = mPassport.ID.ToString Then
            Return True
        Else
            Return False
        End If
    End Function

    REM 检验SessionID 是否为本机
    Protected Function ChkSessionId(ByVal requestSessionId As String) As Boolean
        If requestSessionId Is Nothing Then
            Response.Write(objUI.ErrMsg("802,请提交您的身份标识,否则系统不受理......"))
            ObjectDispose()
            Response.End()
        Else
            If Not requestSessionId = Session.SessionID Then
                Response.Write(objUI.ErrMsg("804,您提交的是过时的数据,系统不受理......"))
                ObjectDispose()
                Response.End()
            End If
        End If
    End Function

    REM 检测Request.Form提交的验证码是否一致
    Protected Function ChkVaidCode() As Boolean
        Dim vCodeCookie As HttpCookie

        If Request.Cookies("CheckCode") Is Nothing Or Request.Form("vCode") Is Nothing Then
            Return False
        Else
            vCodeCookie = Request.Cookies("CheckCode")
            Dim vCode As String = Request.Form("vCode")
            If Request.Cookies("CheckCode").Value = vCode Then
                Request.Cookies.Remove("CheckCode")
                Return True
            Else
                Return False
            End If
        End If
    End Function

    REM 检验Request.QueryString的验证码是否一致
    Protected Function ChkQueryStringVaidCode() As Boolean
        Dim vCodeCookie As HttpCookie

        If Request.Cookies("CheckCode") Is Nothing Or Request.QueryString("vCode") Is Nothing Then
            Return False
        Else
            vCodeCookie = Request.Cookies("CheckCode")
            Dim vCode As String = Request.QueryString("vCode")
            If Request.Cookies("CheckCode").Value = vCode Then
                Request.Cookies.Remove("CheckCode")
                Return True
            Else
                Return False
            End If
        End If
    End Function

#End Region

    Protected Overrides Sub Finalize()
        MyBase.Finalize()
    End Sub
End Class

